home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / PGM_TOOL / DUALEX / DUALEXE.PAS < prev   
Pascal/Delphi Source File  |  1994-08-08  |  11KB  |  340 lines
  1. program DualEXE;
  2.  
  3. (*****************************************************************************)
  4. (*                                                                           *)
  5. (*  DUALEXE.PAS                                                              *)
  6. (*  08/09/94                                                                 *)
  7. (*  Brad Stowers                                                             *)
  8. (*       CIS:      72733,3374                                                *)
  9. (*       Internet: brad.stowers@delta.com                                    *)
  10. (*                                                                           *)
  11. (*  This code first appeared (as far as I know) in the May 1994 issue of     *)
  12. (*  Windows/DOS Developers Journal in the Tech Tips section.  It was written *)
  13. (*  and contributed by:                                                      *)
  14. (*      Paul Bixel                                                           *)
  15. (*           CIS:      71055,423                                             *)
  16. (*           Internet: Bixel_PS@salem.ge.com                                 *)
  17. (*  All credit for this program go to Mr. Bixel.  I did nothing more than    *)
  18. (*  type it in (couldn't find it on the W/DDJ CIS forum library!), add the   *)
  19. (*  prompting for parameters, the conditional defines for Windows, and the   *)
  20. (*  primitive progress display.  In the true spirit of DUALEXE, the included *)
  21. (*  version of DUALEXE.EXE runs equally well under DOS or Windows.           *)
  22. (*                                                                           *)
  23. (*****************************************************************************)
  24. (*                                                                           *)
  25. (*  Combine a Windows and a DOS app together to produce "dual-mode"          *)
  26. (*  executable.  This is an easy thing to do with most Windows C++ compilers *)
  27. (*  but we Pascalers have been denied this "nicety" by Borland.  NO LONGER!! *)
  28. (*  Also, you needn't include just a DOS "stub" program.  You can combine a  *)
  29. (*  full-blown DOS app with your Windows app.                                *)
  30. (*                                                                           *)
  31. (*  Pass in three parameters in this order:                                  *)
  32. (*    The DOS application file name and path.                                *)
  33. (*    The Windows application file name and path.                            *)
  34. (*    The file name and path you want the new EXE to have.                   *)
  35. (*  If any parameters are omitted, you will be prompted for them.            *)
  36. (*                                                                           *)
  37. (*****************************************************************************)
  38.  
  39. {$IFNDEF WINDOWS}
  40. uses CRT;
  41. {$ELSE}
  42. uses WinCRT;
  43. {$ENDIF}
  44.  
  45. type
  46.   { Old style MSDOS header }
  47.   ExeHeader = record
  48.     Sig,
  49.     lpSize,
  50.     PgCnt,
  51.     rItems,
  52.     HdrSize,
  53.     MinAlloc,
  54.     MaxAlloc : word;
  55.     Data1    : LongInt;
  56.     ChkSum   : word;
  57.     Data2    : array[$14..$17] of byte;
  58.     RTOfs,
  59.     OvrNum   : word;
  60.     Data3    : array[$1C..$3B] of byte;
  61.     WinHdr   : LongInt;
  62.   end;
  63.  
  64.   { New style Windows header }
  65.   NewHeader = record
  66.     Sig,
  67.     Ver,
  68.     ETOfs,
  69.     ETLen    : word;
  70.     ChkSum   : LongInt;
  71.     Flags    : word;
  72.     Data1    : array[$0E..$1B] of byte;
  73.     StCnt    : word;
  74.     Data2    : array[$1E..$21] of byte;
  75.     STOff,
  76.     RTOfs    : word;
  77.     Data3    : array[$26..$2B] of byte;
  78.     NROff    : LongInt;
  79.     EpCnt,
  80.     AsCnt,
  81.     RsCnt    : Word;
  82.     OSFlg,
  83.     EXEFlg   : byte;
  84.     FLOfs    : word;
  85.   end;
  86.  
  87.   { Segment table records }
  88.   SegTabEntry = record
  89.     SegOff   : word;
  90.     Data1    : array[2..7] of byte;
  91.   end;
  92.  
  93.   { Resource table group records }
  94.   ResGrpEntry = record
  95.     ResType,
  96.     ResCnt   : word;
  97.     Data     : array[4..7] of byte;
  98.   end;
  99.  
  100.   ResTabEntry = record
  101.     ResOfs,
  102.     ResLen   : word;
  103.     Data     : array[4..11] of byte;
  104.   end;
  105.  
  106. var
  107.   fw,       { Windows app input file }
  108.   fd,       { Dos app input file     }
  109.   fn: file; { New file output handle }
  110.   fwhdr,
  111.   fdhdr,
  112.   fnhdr: EXEHeader;
  113.   nh: NewHeader;
  114.   ResGrp: ResGrpEntry;
  115.   ResEnt: ResTabEntry;
  116.  
  117.   buffer: array[1..1024*30] of byte;
  118.   i: word;
  119.   achange: integer;
  120.   dimage: longint;
  121.   alignment: word;
  122.   shcnt: word;
  123.   stent:SegTabEntry;
  124.   j: longint;
  125.  
  126.   DosFileName,
  127.   WinFileName,
  128.   NewFileName: String;
  129.   SetIcon : boolean;
  130.  
  131. begin
  132. (* Mr. Bixel's original code follows:
  133.   if ParamCount <> 3 then begin
  134.     WriteLn('DUAL-MODE executable creator. v1/1/93');
  135.     Writeln('Usage:');
  136.     Writeln('    dualexe <dosapp> <winapp | winicon> <newappname>');
  137.     exit;
  138.   end;
  139.  
  140.   SetIcon := False;
  141.   FileName := ParamStr(2);
  142.   I := 1;
  143.   while Length(FileName) > i do begin
  144.     FileName[i] := UpCase(FileName[i]);
  145.     inc(i);
  146.   end;
  147.   if Pos(Filename, '.ICO') > 0 then begin
  148.     FileName := 'LAUNCH.EXE';
  149.     SetIcon := TRUE;
  150.   end;
  151.  
  152.   assign(fd, ParamStr(1));
  153.   assign(fw, FileName);
  154.   assign(fn, ParamStr(3));
  155. *)
  156.  
  157.   writeln('DUAL-MODE executable creator.  v1/1/93 by Paul Bixel');
  158.   writeln;
  159.   if (ParamStr(1) = '/?') or (ParamStr(1) = '?') or (ParamStr(1) = '-?') then begin
  160.     writeln('Usage:');
  161.     writeln('    dualexe <dosapp> <winapp | winicon> <newappname>');
  162.     exit;
  163.   end;
  164.  
  165.   if ParamCount < 1 then begin
  166.     write('Enter DOS app file and path:               ');
  167.     readln(DosFileName);
  168.     if DosFileName = '' then exit;
  169.   end else
  170.     DosFileName := ParamStr(1);
  171.  
  172.   if ParamCount < 2 then begin
  173.     write('Enter Windows app (or icon) file and path: ');
  174.     readln(WinFileName);
  175.     if WinFileName = '' then exit;
  176.   end else
  177.     WinFileName := ParamStr(2);
  178.   SetIcon := False;
  179.   I := 1;
  180.   while Length(WinFileName) > i do begin
  181.     WinFileName[i] := UpCase(WinFileName[i]);
  182.     inc(i);
  183.   end;
  184.   if Pos(WinFilename, '.ICO') > 0 then begin
  185.     WinFileName := 'LAUNCH.EXE';
  186.     SetIcon := TRUE;
  187.   end;
  188.  
  189.   if ParamCount < 3 then begin
  190.     write('Enter file and path for new executable:    ');
  191.     readln(NewFileName);
  192.     if NewFileName = '' then exit;
  193.   end else
  194.     NewFileName := ParamStr(3);
  195.  
  196.   writeln;
  197.  
  198.   assign(fd, DosFileName);
  199.   assign(fw, WinFileName);
  200.   assign(fn, NewFileName);
  201.  
  202.   reset(fw, 1);
  203.   reset(fd, 1);
  204.   rewrite(fn, 1);
  205.  
  206.   BlockRead(fw, fwhdr, sizeof(fwhdr));
  207.   BlockRead(fd, fdhdr, sizeof(fdhdr));
  208.  
  209.   { Read the windows file New Header }
  210.   seek(fw, fwhdr.winhdr);
  211.   BlockRead(fw, nh, sizeof(nh));
  212.  
  213.   { New Old Style header most like DOS program's }
  214.   fnhdr := fdhdr;
  215.  
  216.   { Calculate the DOS load image size }
  217.   dimage := fdhdr.pgcnt*longint(512)+fdhdr.lpsize-fdhdr.hdrsize*longint(16)-longint(512);
  218.  
  219.   fnhdr.rtofs := $40;
  220.   fnhdr.chksum := 0;
  221.  
  222.   { calc alignment shift }
  223.   shcnt := nh.ascnt mod 9;
  224.   if shcnt = 0 then shcnt := 9;
  225.   alignment := 1 shl shcnt;
  226.  
  227.   { where will new win header be? }
  228.   fnhdr.winhdr := (((filesize(fd) + $40 -fdhdr.rtofs + alignment - 1) shr shcnt) shl shcnt);
  229.  
  230.   { calculate the new header size in paragraphs }
  231.   fnhdr.hdrsize := ($40+fdhdr.ritems*4+15) div 16;
  232.  
  233.   { calculate new file size parameters }
  234.   fnhdr.lpsize := (fnhdr.hdrsize*16+dimage) mod 512;
  235.   fnhdr.pgcnt := (fnhdr.hdrsize*16+dimage+511) div 512;
  236.  
  237.   { write the old style header to the new file }
  238.   BlockWrite(fn, fnhdr, $40);
  239.  
  240.   { write the DOS relocation table }
  241.   seek(fd, fdhdr.rtofs);
  242.   if fdhdr.ritems > 0 then begin
  243.     BlockRead(fd, buffer, fdhdr.ritems*4);
  244.     BlockWrite(fn, buffer, fdhdr.ritems*4);
  245.   end;
  246.  
  247.   { write up to the next paragraph }
  248.   i := filepos(fn);
  249.   fillchar(buffer, sizeOf(buffer), #0);
  250.   if (i mod 16) <> 0 then
  251.     BlockWrite(fn, buffer, 16-(i mod 16));
  252.  
  253.   { Transfer entire DOS image }
  254.   write('Copying DOS app.');
  255.   seek(fd, fdhdr.hdrsize*16);
  256.   repeat
  257.     BlockRead(fd, buffer, sizeof(buffer), i);
  258.     if (i > 0) then BlockWrite(fn, buffer, i);
  259.     write('.');
  260.   until (i <> sizeof(buffer));
  261.   writeln;
  262.  
  263.   { Fill out the last page till the windows header }
  264.   if fnhdr.winhdr-filepos(fn) > 0 then begin
  265.     fillchar(buffer, sizeof(buffer), #0);
  266.     BlockWrite(fn, buffer, fnhdr.winhdr-filepos(fn));
  267.   end;
  268.  
  269.   { compute the adjustment for segment oriented offsets }
  270.   if fnhdr.winhdr >= fwhdr.winhdr then
  271.     achange := (fnhdr.winhdr - fwhdr.winhdr + alignment - 1) shr shcnt
  272.   else
  273.     achange := -((fwhdr.winhdr - fnhdr.winhdr + alignment - 1) shr shcnt);
  274.  
  275.   { Adjust the fast load area if used }
  276.   if (nh.exeflg and 8) > 0 then inc(nh.flofs,achange);
  277.   { Adjust the new header name table offset }
  278.   nh.nroff := nh.nroff - fwhdr.winhdr + fnhdr.winhdr;
  279.  
  280.   { Blank the checksum }
  281.   nh.chksum := 0;
  282.  
  283.   { Insert the entire window application header and image }
  284.   write('Adding Windows app.');
  285.   Seek(fw, fwhdr.winhdr+sizeof(nh));
  286.   BlockWrite(fn, nh, sizeof(nh));
  287.   repeat
  288.     BlockRead(fw, buffer, sizeof(buffer), i);
  289.     if (i > 0) then BlockWrite(fn, buffer, i);
  290.     write('.');
  291.   until (i <> sizeof(buffer));
  292.   writeln;
  293.  
  294.   { Go back and fix segment table offsets }
  295.   seek(fn, fnhdr.winhdr+nh.stoff);
  296.   seek(fw, fwhdr.winhdr+nh.stoff);
  297.  
  298.   while nh.stcnt > 0 do begin
  299.     BlockRead(fw, stent,sizeof(stent));
  300.     if (stent.segoff<>0) then inc(stent.segoff,achange);
  301.     BlockWrite(fn, stent, sizeof(stent));
  302.     dec(nh.stcnt);
  303.   end;
  304.  
  305.   { Now doctor up the resource tables offsets }
  306.   Seek(fw, fwhdr.winhdr+nh.rtofs);
  307.   seek(fn, fnhdr.winhdr+nh.rtofs+2);
  308.   BlockRead(fw, shcnt, 2);
  309.   alignment := 1 shl shcnt;
  310.  
  311.   if fnhdr.winhdr >= fwhdr.winhdr then
  312.     achange := (fnhdr.winhdr - fwhdr.winhdr + alignment - 1) shr shcnt
  313.   else
  314.     achange := -((fwhdr.winhdr - fnhdr.winhdr + alignment - 1) shr shcnt);
  315.  
  316.   write('Inserting resources.');
  317.   repeat
  318.     BlockRead(fn, resgrp, sizeof(resgrp));
  319.     BlockRead(fw, resgrp, sizeof(resgrp));
  320.  
  321.     while (resgrp.restype <> 0) and (resgrp.rescnt > 0) do begin
  322.       BlockRead(fw, resent, sizeof(resent));
  323.       inc(resent.resofs, achange);
  324.       BlockWrite(fn, resent, sizeof(resent));
  325.       dec(resgrp.rescnt);
  326.       write('.');
  327.     end;
  328.   until (resgrp.restype = 0);
  329.   writeln;
  330.   writeln;
  331.  
  332.   writeln('Finished.  ', NewFileName, ' written.  New size is ', filesize(fn), ' bytes.');
  333.  
  334.   { Done so close everyone up }
  335.   Close(fn);
  336.   Close(fd);
  337.   Close(fw);
  338.  
  339. end.
  340.